home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / XLISP.LZH / XLISPSRC.ARC / XLINIT.C < prev    next >
Text File  |  1986-04-05  |  4KB  |  124 lines
  1. /* xlinit.c - xlisp initialization module */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern NODE *true,*s_dot;
  10. extern NODE *s_quote,*s_function,*s_bquote,*s_comma,*s_comat;
  11. extern NODE *s_lambda,*s_macro;
  12. extern NODE *s_stdin,*s_stdout;
  13. extern NODE *s_evalhook,*s_applyhook;
  14. extern NODE *s_tracenable,*s_tlimit,*s_breakenable;
  15. extern NODE *s_car,*s_cdr,*s_nth,*s_get,*s_svalue,*s_splist,*s_aref,*s_eql;
  16. extern NODE *s_rtable,*k_wspace,*k_const,*k_nmacro,*k_tmacro;
  17. extern NODE *k_test,*k_tnot,*k_optional,*k_rest,*k_aux;
  18. extern NODE *a_subr,*a_fsubr;
  19. extern NODE *a_list,*a_sym,*a_int,*a_float,*a_str,*a_obj,*a_fptr,*a_vect;
  20. extern NODE *s_gcflag;
  21. extern struct fdef ftab[];
  22.  
  23. /* xlinit - xlisp initialization routine */
  24. xlinit()
  25. {
  26.     struct fdef *fptr;
  27.     NODE *sym;
  28.  
  29.     /* initialize xlisp (must be in this order) */
  30.     xlminit();    /* initialize xldmem.c */
  31.     xlsinit();    /* initialize xlsym.c */
  32.     xldinit();    /* initialize xldbug.c */
  33.     xloinit();    /* initialize xlobj.c */
  34.  
  35.     /* enter the builtin functions */
  36.     for (fptr = ftab; fptr->f_name; fptr++)
  37.     xlsubr(fptr->f_name,fptr->f_type,fptr->f_fcn);
  38.  
  39.     /* enter operating system specific functions */
  40.     osfinit();
  41.  
  42.     /* enter the 't' symbol */
  43.     true = xlsenter("T");
  44.     setvalue(true,true);
  45.  
  46.     /* enter some important symbols */
  47.     s_dot    = xlsenter(".");
  48.     s_quote    = xlsenter("QUOTE");
  49.     s_function    = xlsenter("FUNCTION");
  50.     s_bquote    = xlsenter("BACKQUOTE");
  51.     s_comma    = xlsenter("COMMA");
  52.     s_comat    = xlsenter("COMMA-AT");
  53.     s_lambda    = xlsenter("LAMBDA");
  54.     s_macro    = xlsenter("MACRO");
  55.     s_eql    = xlsenter("EQL");
  56.  
  57.     /* enter setf place specifiers */
  58.     s_car    = xlsenter("CAR");
  59.     s_cdr    = xlsenter("CDR");
  60.     s_nth    = xlsenter("NTH");
  61.     s_get    = xlsenter("GET");
  62.     s_svalue    = xlsenter("SYMBOL-VALUE");
  63.     s_splist    = xlsenter("SYMBOL-PLIST");
  64.     s_aref    = xlsenter("AREF");
  65.  
  66.     /* enter the readtable variable and keywords */
  67.     s_rtable    = xlsenter("*READTABLE*");
  68.     k_wspace    = xlsenter(":WHITE-SPACE");
  69.     k_const    = xlsenter(":CONSTITUENT");
  70.     k_nmacro    = xlsenter(":NMACRO");
  71.     k_tmacro    = xlsenter(":TMACRO");
  72.     xlrinit();
  73.  
  74.     /* enter parameter list keywords */
  75.     k_test    = xlsenter(":TEST");
  76.     k_tnot    = xlsenter(":TEST-NOT");
  77.  
  78.     /* enter lambda list keywords */
  79.     k_optional    = xlsenter("&OPTIONAL");
  80.     k_rest    = xlsenter("&REST");
  81.     k_aux    = xlsenter("&AUX");
  82.  
  83.     /* enter *standard-input* and *standard-output* */
  84.     s_stdin = xlsenter("*STANDARD-INPUT*");
  85.     setvalue(s_stdin,cvfile(stdin));
  86.     s_stdout = xlsenter("*STANDARD-OUTPUT*");
  87.     setvalue(s_stdout,cvfile(stdout));
  88.  
  89.     /* enter the eval and apply hook variables */
  90.     s_evalhook = xlsenter("*EVALHOOK*");
  91.     setvalue(s_evalhook,NIL);
  92.     s_applyhook = xlsenter("*APPLYHOOK*");
  93.     setvalue(s_applyhook,NIL);
  94.  
  95.     /* enter the error traceback and the error break enable flags */
  96.     s_tracenable = xlsenter("*TRACENABLE*");
  97.     setvalue(s_tracenable,NIL);
  98.     s_tlimit = xlsenter("*TRACELIMIT*");
  99.     setvalue(s_tlimit,NIL);
  100.     s_breakenable = xlsenter("*BREAKENABLE*");
  101.     setvalue(s_breakenable,NIL);
  102.  
  103.     /* enter a symbol to control printing of garbage collection messages */
  104.     s_gcflag = xlsenter("*GC-FLAG*");
  105.     setvalue(s_gcflag,NIL);
  106.  
  107.     /* enter a copyright notice into the oblist */
  108.     sym = xlsenter("**Copyright-1986-by-David-Betz**");
  109.     setvalue(sym,true);
  110.  
  111.     /* enter type names */
  112.     a_subr    = xlsenter(":SUBR");
  113.     a_fsubr    = xlsenter(":FSUBR");
  114.     a_list    = xlsenter(":CONS");
  115.     a_sym    = xlsenter(":SYMBOL");
  116.     a_int    = xlsenter(":FIXNUM");
  117.     a_float    = xlsenter(":FLONUM");
  118.     a_str    = xlsenter(":STRING");
  119.     a_obj    = xlsenter(":OBJECT");
  120.     a_fptr    = xlsenter(":FILE");
  121.     a_vect    = xlsenter(":ARRAY");
  122. }
  123.  
  124.